home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 03 - 1987 / 03.09 Sep 87 / fortran source / misc stuff / Printer Subroutines / scrdmp.for next >
Encoding:
Text File  |  1986-03-12  |  1.9 KB  |  68 lines  |  [TEXT/EDIT]
  1.         integer function scrdmp
  2. * This subroutine prints the current screen image to the imagewritter printer.
  3. * This is equivalent to entering a caps lock-command-shift-4 from the keyboard.
  4. * It must be called with an empty parameter list, so that the
  5. * compiler can distinguish it from a simple variable:
  6. *
  7. *       error = scrdmp()
  8. *
  9. * 12 Mar 86    Sent to Compuserve.                EWG
  10.  
  11.         implicit none
  12.         integer toolbx
  13.  
  14.         include file.inc
  15.         include misc.inc
  16.         include params.inc
  17.  
  18. * Constant print driver reference number.
  19.         integer iprdrvrref
  20.         parameter (iprdrvrref = -3)
  21.  
  22. * Eqivalence a 3 words (integer*2) over the first 6 elements of the byte array
  23. * csparam (in params.inc) for convenience in setting up the printer port.
  24.         integer*2 prcont(3)             ! Print protocol control words.
  25.         equivalence (csparam(1),prcont(1))
  26.  
  27.         character*7 filename            ! Used to build print driver name.
  28.  
  29.         integer err                     ! Error code for file calls.
  30.         integer i                       ! scratch
  31.  
  32.         integer paramptr                ! Pointer to the parameter block.
  33.  
  34. * Clear the file parameter block.
  35.         do (i = 1, 80)
  36.           params(i) = 0
  37.         repeat
  38.  
  39.         paramptr = toolbx(PTR, params)  ! Pointer to parameter block.
  40.  
  41. * Open the printer port for output.
  42.         filename = char(6) // '.PRINT'
  43.         ionameptr = toolbx(PTR, filename)
  44.         err = toolbx(PBOPEN, paramptr)
  45.         if (err <> 0) goto 100
  46.  
  47. * Reset the printer.
  48.         cscode = 7
  49.         prcont(1) = 1
  50.         prcont(2) = 0
  51.         err = toolbx(PBCONTROL, paramptr)
  52.         if (err <> 0) goto 100
  53.  
  54. * Print the screen.
  55.         cscode = 6
  56.         prcont(1) = 2
  57.         prcont(2) = 0                   ! Default - use 1 for square pixels.
  58.         err = toolbx(PBCONTROL, paramptr)
  59.         if (err <> 0) goto 100
  60.  
  61. * Close the printer port.
  62.         err = toolbx(PBCLOSE, paramptr)
  63.  
  64.   100   scrdmp = err
  65.  
  66.         return
  67.         end
  68.